home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / workdir.tcl.z / workdir.tcl
Encoding:
Text File  |  1999-04-16  |  30.7 KB  |  1,007 lines
  1. #
  2. # TCL Library for tkcvs
  3. #
  4.  
  5. #
  6. # $Id: workdir.tcl,v 1.39 1995/11/22 00:54:01 davide Exp $
  7. #
  8. # Current working directory display.  Handles all of the functions
  9. # concerned with navigating about the current directory on the main
  10. # window.
  11. #
  12.  
  13. # Note that the mark canvas no longer exists in this revision of the
  14. # code.  This is because Tk 4.0 supports non-adjacent selections in
  15. # listbox widgets, and so the code is no longer necessary.  It still
  16. # exists on a development branch in case it is needed later.
  17.  
  18. set indexPrefix "^"
  19. set filenamePrefix "!"
  20.  
  21. proc workdir_setup {} {
  22.   global cwd
  23.   global module_dir
  24.   global cvscfg
  25.   global TOOLTIPS_OFF
  26.   global local_bitmapdir
  27.   global feedback
  28.  
  29.   frame .top -relief groove -border 2
  30.   frame .cleft     
  31.   frame .center
  32.   frame .cright    
  33.   frame .crbottom  
  34.   frame .clbottom  
  35.     
  36.   frame .top_left  
  37.   frame .top_right 
  38.   frame .bottom 
  39.   frame .bottom1 -relief groove -border 2
  40.   frame .bottom2 -relief groove -border 2
  41.   frame .bottom1label
  42.   frame .bottom2label
  43.   frame .bottom1workspace
  44.   frame .bottom2workspace
  45.     
  46.   pack .top                           -side top    -fill x
  47.   pack .top_left         -in .top     -side left   
  48.   pack .top_right        -in .top     -side right  -fill x -expand yes
  49.   pack .center                        -side left   -fill both -expand yes
  50.  
  51.   pack .bottom           -in .center  -side bottom -fill x
  52.   pack .bottom1          -in .bottom  -side top    -fill x
  53.   pack .bottom1label     -in .bottom1 -side top    -fill x    -expand yes
  54.   pack .bottom1workspace -in .bottom1 -side bottom -fill both -expand yes
  55.   if {$cvscfg(buttonstyle) == "Text"} {
  56.     pack .bottom2          -in .bottom  -side bottom -fill x
  57.     pack .bottom2label     -in .bottom2 -side top    -fill x    -expand yes
  58.     pack .bottom2workspace -in .bottom2 -side bottom -fill both -expand yes
  59.   }
  60.  
  61.   pack .cleft            -in .center  -side left   -fill both -expand yes
  62.   pack .cright           -in .center  -side right  -fill both -expand yes
  63.   pack .crbottom         -in .cright  -side bottom -fill both -expand yes    
  64.   pack .clbottom         -in .cleft   -side bottom -fill both -expand yes
  65.     
  66.   #
  67.   # Top section of the screen ("commentary").
  68.   #
  69.  
  70.   label .lcwd        -text "Current Directory" -anchor w
  71.   label .lmodule     -text "Module Location"   -anchor w
  72.   label .lfilter     -text "Filter:"           -anchor w 
  73.   label .lworkspace  -text "Workspace"         -anchor w
  74.   label .lrepository -text "Repository"        -anchor w
  75.  
  76.   entry .tcwd     -textvariable cwd         -relief sunken 
  77.   label .tmodule  -textvariable module_dir  -anchor w
  78.   entry .tfilter  -textvariable cvscfg(file_filter) -relief sunken 
  79.   # bind_motifentry .tcwd
  80.   bind .tcwd        <Return> {setup_dir}
  81.   # bind_motifentry .tfilter
  82.   bind .tfilter        <Return> {setup_dir}
  83.  
  84.   #
  85.   # The central portion of the main screen.  This is where all of the
  86.   # files and their statuses (for CVS 1.3 and later) are listed.
  87.   #
  88.   listbox   .file_list   -yscroll {.scroll set} \
  89.     -relief sunken -width 40 -height $cvscfg(y_size) -setgrid yes \
  90.     -selectmode extended
  91.   listbox   .status_list -yscroll {.scroll set} \
  92.     -relief sunken -width 20 -height $cvscfg(y_size) -setgrid yes
  93.   scrollbar .scroll  -command {workdir_scroll} \
  94.     -relief sunken
  95.         
  96.   # Mouse button bindings need some work; i.e., there should be a richer set.
  97.   bind .file_list   <Double-Button-1> \
  98.     { workdir_act_on_file [workdir_list_files] }
  99.   bind .file_list   <Button-2>        \
  100.     { nop }
  101.   bind .file_list   <ButtonRelease-3> \
  102.     { nop }
  103.  
  104.   #bind .status_list <Double-Button-1> { workdir_status_of_file %y }
  105.   #bind .status_list <ButtonRelease-1> { workdir_status_list_file %y }
  106.   #bind .status_list <1>               { workdir_status_list_file %y }
  107.   bind .status_list <Double-Button-1> { nop }
  108.   bind .status_list <ButtonRelease-1> { nop }
  109.   bind .status_list <1>               { nop }
  110.   bind .status_list <2>               { nop }
  111.   bind .status_list <Any-B1-Motion>   { nop }
  112.   bind .status_list <Any-B2-Motion>   { nop }
  113.   bind .status_list <Any-B3-Motion>   { nop }
  114.   
  115.   #
  116.   # Packing for the top two sections.
  117.   #
  118.   pack .lcwd     -in .top_left  -side top   -fill x -pady 3
  119.   pack .lmodule  -in .top_left  -side top   -fill x
  120.   pack .tcwd     -in .top_right -side top   -fill x -pady 3
  121.   pack .tmodule  -in .top_right -side top   -fill x -pady 1
  122.   pack .lworkspace .lfilter .tfilter -in .bottom1label -side left 
  123.   pack .lrepository  -in .bottom2label -side left 
  124.     
  125.   pack .file_list                   -in .clbottom  -side left  \
  126.     -fill both    -expand yes
  127.   pack .status_list                 -in .crbottom  -side left  \
  128.     -fill both    -expand yes            
  129.   pack .scroll                      -in .crbottom  -side right \
  130.     -fill y       -expand yes -padx 2 
  131.     
  132.   #
  133.   # Action buttons along the bottom of the screen.
  134.   #
  135.   button .bcheck        -relief raised \
  136.     -command cvs_check
  137.   button .bedit_files   -relief raised \
  138.     -command { workdir_act_on_file [workdir_list_marked_files] }
  139.   button .bdelete_file  -relief raised \
  140.     -command { workdir_delete_file [workdir_list_marked_files] }
  141.   button .bclear        -relief raised \
  142.     -command { .file_list select clear 0 end }
  143.   button .brefresh      -relief raised \
  144.     -command setup_dir
  145.   button .blogfile      -relief raised \
  146.     -command { eval cvs_logcanvas  [workdir_list_marked_files] }
  147.   button .bclean        -relief raised \
  148.     -command workdir_cleanup
  149.  
  150.   if {$cvscfg(buttonstyle) == "Text"} {
  151.     .bcheck        configure -text "Check"
  152.     .bedit_files   configure -text "Edit"
  153.     .bdelete_file  configure -text "Delete"
  154.     .bclear        configure -text "Clear"
  155.     .brefresh      configure -text "Refresh"
  156.     .blogfile      configure -text "Log Browse"
  157.     .bclean        configure -text "Clean"
  158.   } else {
  159.     .bcheck        configure -bitmap @$local_bitmapdir/check.xbm
  160.     .bedit_files   configure -bitmap @$local_bitmapdir/notebook.xbm
  161.     .bdelete_file  configure -bitmap @$local_bitmapdir/delete.xbm
  162.     .bclear        configure -bitmap @$local_bitmapdir/clear.xbm
  163.     .brefresh      configure -bitmap @$local_bitmapdir/refresh.xbm
  164.     .blogfile      configure -bitmap @$local_bitmapdir/logfile.xbm
  165.     .bclean        configure -bitmap @$local_bitmapdir/clean.xbm
  166.   }
  167.  
  168.   # Tooltips for the above buttons.
  169.  
  170.   if !{$TOOLTIPS_OFF} {
  171.     set_tooltips .bedit_files \
  172.       {"Edit the selected files using $cvscfg(editor)"}
  173.     set_tooltips .bdelete_file \
  174.       {{Delete the selected files}}
  175.     set_tooltips .bclear \
  176.       {{Unselect all files}}
  177.     set_tooltips .brefresh \
  178.       {{Re-read the current directory}}
  179.     set_tooltips .blogfile \
  180.       {{See the revision log of the selected files}}
  181.     set_tooltips .bclean \
  182.       {{Remove all backup files from the current directory}}
  183.   }
  184.  
  185.   button .badd_files    -relief raised \
  186.     -command { cvs_add             [workdir_list_marked_files] }
  187.   button .bremove       -relief raised \
  188.     -command {cvs_remove           [workdir_list_marked_files] }
  189.   button .bdiff         -relief raised \
  190.     -command { eval cvs_diff       [workdir_list_marked_files] } 
  191.   button .bcheckin      -relief raised \
  192.     -command commit_run
  193.   button .bupdate       -relief raised \
  194.     -command { cvs_update       "" [workdir_list_marked_files] }
  195.   button .bmodbrowse    -relief raised \
  196.     -command checkout_run
  197.   button .bimport       -relief raised \
  198.     -command import_run
  199.   button .bquit         -relief raised \
  200.     -command exit
  201.     
  202.   if {$cvscfg(buttonstyle) == "Text"} {
  203.     .badd_files    configure -text "Add"
  204.     .bremove       configure -text "Remove"
  205.     .bcheckin      configure -text "Check In"
  206.     .bupdate       configure -text "Update"
  207.     .bdiff         configure -text "Diff"
  208.     .bmodbrowse    configure -text "Module Browse"
  209.     .bimport       configure -text "Import"
  210.     .bquit         configure -text "Quit"
  211.   } else {
  212.     .badd_files    configure -bitmap @$local_bitmapdir/add.xbm
  213.     .bremove       configure -bitmap @$local_bitmapdir/remove.xbm
  214.     .bcheckin      configure -bitmap @$local_bitmapdir/checkin.xbm
  215.     .bupdate       configure -bitmap @$local_bitmapdir/update.xbm
  216.     .bdiff         configure -bitmap @$local_bitmapdir/diff.xbm
  217.     .bmodbrowse    configure -bitmap @$local_bitmapdir/tree16.xbm
  218.     .bimport       configure -bitmap @$local_bitmapdir/import.xbm
  219.     .bquit         configure -text "Quit"
  220.   }
  221.  
  222.   # ToolTips popups for the buttons.
  223.  
  224.   if !{$TOOLTIPS_OFF} {
  225.     set_tooltips .bcheck \
  226.       {{Check the files in the current directory against the repository}}
  227.     set_tooltips .badd_files \
  228.       {{Add the selected files to the repository}}
  229.     set_tooltips .bremove \
  230.       {{Remove the selected files from the repository}}
  231.     set_tooltips .bcheckin \
  232.       {{Check the selected files in to the repository}}
  233.     set_tooltips .bupdate \
  234.       {{Update the selected files from the repository}}
  235.     set_tooltips .bdiff \
  236.       {{See the differences between the selected files and the repository}}
  237.     set_tooltips .bmodbrowse \
  238.       {{Browse the modules in the repository or check out a module}}
  239.     set_tooltips .bimport \
  240.       {{Import the current directory into the repository}}
  241.     set_tooltips .bquit \
  242.       {{Exit from tkCVS}}
  243.   }
  244.  
  245.   #
  246.   # Pack the buttons.
  247.   #
  248.   if {$cvscfg(buttonstyle) == "Text"} {
  249.     pack .bcheck .bedit_files .bdelete_file .bclear .brefresh .blogfile .bclean \
  250.       -ipadx 2 -ipady 2 -padx 4 -pady 4 \
  251.       -in .bottom1workspace -side left -fill both -expand 1
  252.     pack .badd_files .bremove .bdiff .bcheckin .bupdate \
  253.          .bmodbrowse .bimport .bquit \
  254.       -ipadx 2 -ipady 2 -padx 4 -pady 4 \
  255.       -in .bottom2workspace -side left -fill both -expand 1
  256.   } else {
  257.     pack .bcheck .bedit_files .bdelete_file .bclear .brefresh .blogfile .bclean \
  258.          .badd_files .bremove .bdiff .bcheckin .bupdate \
  259.          .bmodbrowse .bimport \
  260.          -ipadx 1 -ipady 1 -padx 1 -pady 1 \
  261.          -in .bottom1workspace -side left
  262.     pack .bquit \
  263.       -ipadx 2 -ipady 2 -padx 4 -pady 4 \
  264.       -in .bottom1workspace -side right
  265.   }
  266.  
  267.   #
  268.   # Entry widget to be used for feedback
  269.   #
  270.   set feedback(cvs) [entry .feedback -width 55]
  271.   pack .feedback -in .bottom -side bottom -fill x -expand yes
  272.     
  273.   setup_dir
  274. }
  275.  
  276. proc workdir_list_marked_files {} {
  277.     return [ workdir_list_files ]
  278. }
  279.  
  280. proc markedFiles { c } {
  281.   #puts stdout "markedFiles ..."
  282.   set id_list [ $c find withtag selected ]
  283.   set filelist ""
  284.  
  285.   foreach id $id_list {
  286.     lappend filelist [ getFilename $id $c ]
  287.   }
  288.   #puts stdout "markedFiles ... done"
  289.  
  290.   return $filelist
  291. }
  292.  
  293. proc getFilename { id c } {
  294.   global filenamePrefix
  295.   #puts stdout "getFilename ..."
  296.   set taglist [ getTagList $id $c ]
  297.   set tagpos  [ lsearch $taglist $filenamePrefix* ]
  298.   set tag     [ lindex $taglist $tagpos ]
  299.   set filename [lindex [ split $tag $filenamePrefix ] 1 ]
  300.   #puts stdout "Filename prefix is \"$filenamePrefix\""
  301.   #puts stdout "Filename taglist is \"$taglist\""
  302.   #puts stdout "Filename tagpos is \"$tagpos\""
  303.   #puts stdout "Filename tag is \"$tag\""
  304.   #puts stdout "Filename is \"$filename\""
  305.   return $filename
  306.   #puts stdout "getFilename ... done"
  307. }
  308.  
  309. proc getTagList { id c } {
  310.   #puts stdout "getTagList ..."
  311.   #puts stdout "Taglist is \"[lindex [ $c itemconf $id -tags ] 4 ]\""
  312.   return [lindex [ $c itemconf $id -tags ] 4]
  313.   #puts stdout "getTagList ... done"
  314. }
  315.  
  316. proc workdir_list_files {} {
  317.   #puts stdout "workdir_list_files ..."
  318.   foreach item [.file_list curselection] {
  319.     if [info exists getlist] {
  320.       lappend getlist [.file_list get $item]
  321.     } else {
  322.       set getlist [.file_list get $item]
  323.     }
  324.   }
  325.  
  326.   if [info exists getlist] {
  327.     return $getlist
  328.   } else {
  329.     return {}
  330.   }
  331. }
  332.  
  333. proc workdir_act_on_file {filename} {
  334.   global cvscfg
  335.   global cwd
  336.  
  337.   feedback_cvs "Building scroll list, please wait!"
  338.   if [file isdirectory $filename] {
  339.     change_dir $filename
  340.   } else {
  341.     set commandline "exec $cvscfg(editor)"
  342.     foreach file $filename {
  343.       if {$cvscfg(editorargs) == {}} {
  344.         exec $cvscfg(editor) $file > /dev/null &
  345.       } else {
  346.         exec $cvscfg(editor) $cvscfg(editorargs) $file > /dev/null &
  347.       }
  348.     }
  349.   }
  350.   feedback_cvs ""
  351. }
  352.  
  353. proc workdir_status_list_files {} {
  354.     foreach item [.status_list curselection] {
  355.         if [info exists getlist] {
  356.             lappend getlist [.file_list get $item]
  357.         } else {
  358.             set getlist [.file_list get $item]
  359.         }
  360.     }
  361.  
  362.     if [info exists getlist] {
  363.         set cur_select [.status_list curselection]
  364.         set start_pos [ lindex $cur_select 0 ]
  365.         set end_pos   [ expr [ llength $cur_select ] + $start_pos - 1 ]
  366.         .file_list select set $start_pos $end_pos
  367.         return $getlist
  368.     } else {
  369.         set cur_select [.status_list curselection]
  370. #       cvserror "button pressed: curselection =$cur_select"
  371.         return {}
  372.     }
  373. }
  374.  
  375. proc workdir_status_list_file {yposition} {
  376.     set cur_select [.status_list nearest $yposition]
  377.     # .file_list select from $cur_select
  378.     # .file_list select to   $cur_select
  379.     return $cur_select
  380. }
  381.  
  382.  
  383. proc workdir_status_of_file {yposition} {
  384. #
  385. # Do this when file is double-clicked on
  386. #
  387.   global file_list
  388.  
  389.   .file_list select set [ .status_list nearest $yposition ]
  390.  
  391.   set ypos [ .status_list nearest $yposition ]
  392.   set filename [ .file_list get $ypos ]
  393.   if [file isdirectory $filename] {
  394.       change_dir $filename
  395.   } else {
  396.       .status_list insert $ypos [ workdir_status_list_files ]
  397.   }
  398. }
  399.  
  400. #-------------------------------
  401. #-------------------------------
  402. proc change_dir_rel {new_dir} {
  403.   global cwd
  404.  
  405.   update_go $new_dir 0
  406.   set cwd $new_dir
  407.   setup_dir
  408. }
  409.  
  410.  
  411. #------------------------------------------------------
  412. # Update the "Go" menu for directories we can go to
  413. # new_dir - the directory we're going to
  414. # doPwd   - tells whether the directory path has
  415. #           been specified  1 means relative to cwd
  416. #                           0 means fully path specified
  417. #-------------------------------------------------------
  418. proc update_go {new_dir doPwd} {
  419.   global .menubar.goto.m
  420.   global dirlist
  421.   global maxdirs
  422.   global dirlen
  423.   
  424.   if {$new_dir == "." } { return }
  425.   if {$new_dir == ".."} { return }
  426.   if {$new_dir == "~" } { return }
  427.  
  428.   # Get full pathname of directory
  429.   if {$doPwd == "1"} {
  430.      set new_dir [format {%s/%s} [pwd] $new_dir ]
  431.   }
  432.  
  433.   # Check if already in Go list
  434.   set dirlocation  [lsearch -exact $dirlist $new_dir]
  435.  
  436.   # Move a directory already in the list to the top of the list
  437.   if {$dirlocation != -1} {
  438.     set dirlist [lreplace $dirlist $dirlocation $dirlocation ]
  439.     set dirlist [linsert $dirlist 0 $new_dir]
  440.   } else {
  441.     set dirlist [linsert $dirlist 0 $new_dir]
  442.   }
  443.   set dirlen  [llength $dirlist]
  444.  
  445.   # Truncate end of directory list if we have too many directories
  446.   if {$dirlen > $maxdirs} {
  447.     set $dirlen [incr dirlen -1]
  448.     set dirlist [lreplace $dirlist $dirlen $dirlen ]
  449.   }
  450.  
  451.   # Destroy old menu selections for "Go"
  452.   destroy .menubar.goto.m
  453.   menu .menubar.goto.m
  454.   .menubar.goto.m add command -label "Home" \
  455.      -command {change_dir ~}
  456.  
  457.   # Rebuild menu selections for "Go" with new dirlist
  458.   for {set i 0} {$i < $dirlen} {incr i 1} {
  459.     set tmpdir [lindex $dirlist $i]
  460.     .menubar.goto.m add command -label $tmpdir \
  461.       -command [ format {change_dir_rel %s} $tmpdir ]
  462.   }
  463. }
  464.  
  465. proc change_dir {new_dir} {
  466.   global cwd
  467.  
  468.   update_go $new_dir 1
  469.   set cwd $new_dir
  470.   setup_dir
  471. }
  472.  
  473.  
  474. # I modified this a lot to support the status listbox and marked canvas.
  475. # I cringe at the size of the procedure -- it needs to be broken into smaller 
  476. # ones badly.
  477. # -sj
  478.  
  479. proc setup_dir {} {
  480.   #
  481.   # Call this when entering a directory.  It puts all of the file names
  482.   # in the listbox, and reads the CVS or CVS.adm directory.
  483.   #
  484.   global cvsroot
  485.   global cwd
  486.   global module_dir
  487.   global incvs
  488.   global cvscfg
  489.     
  490.   #puts stdout "setup_dir: entering procedure."
  491.   .file_list delete 0 end
  492.   .status_list delete 0 end
  493.   set module_dir "Not in the repository"
  494.   set incvs 0
  495.  
  496.   set unknown_in_repository      "          ????"
  497.   set directory_label            "                      < dir >"
  498.   set up_to_date_with_repository "            ok"
  499.   set locally_lost               " locally lost!"
  500.     
  501.   if [file isdirectory $cwd] {
  502.     cd $cwd
  503.     set cwd [pwd]
  504.  
  505.     set filelist [ getFiles ]
  506.  
  507.     set j 0
  508.     foreach i $filelist {
  509.       if { [ isCmDirectory $i ] } {
  510.         if {$i == "CVS"} {
  511.           # New format CVS directory
  512.           read_cvs_dir $cwd/$i
  513.         } elseif {$i == "CVS.adm"} {
  514.           # Old format CVS.adm directory
  515.           read_cvs_adm_dir $cwd/$i
  516.         } else {
  517.           nop
  518.         }
  519.       } else {
  520.         .file_list insert end $i
  521.         #puts stdout "Inserting file($j): $i"
  522.         # count actual number of visible elements (not showing CM directories)
  523.         set j [ expr $j + 1 ]
  524.       }
  525.     }
  526.     cvsroot_check
  527.  
  528.     if {! $incvs} {
  529.       #puts stdout "setup_dir: not under CVS."
  530.       set module_dir "Not a CVS directory."
  531.       # .status_list configure -background $cvscfg(glb_dir_mark_color)
  532.       # unpack the status listbox and scrollbar from the screen
  533.       pack forget .cright .scroll
  534.       # repack the scrollbar into the file listbox
  535.       pack .scroll -in .clbottom -side right -fill y -expand yes -padx 2
  536.     } elseif { $cvscfg(cvsver) > 1.2 } {
  537.       # make sure the scroll bar is in the right frame
  538.       pack forget .scroll 
  539.       pack .cright -in .center   -side right -fill both -expand yes
  540.       pack .scroll -in .crbottom -side right -fill y -expand yes -padx 2
  541.       # .status_list configure -background $cvscfg(glb_background)
  542.       if { $cvscfg(auto_status) == "true" }  {
  543.         #puts stdout "setup_dir: performing auto status."
  544.         set status_pairs [ cvs_file_status_pairs ] 
  545.         set pair_index 0
  546.         set pair_list_count [ llength $status_pairs ]
  547.         set file_index 0
  548.         set file_list_count [ llength $filelist ]
  549.         while { ( $pair_index < $pair_list_count ) && ( $file_index < $file_list_count ) } {
  550.           #puts stdout "setup_dir: getting next status pair."
  551.           set a_pair [ lindex $status_pairs $pair_index ]
  552.           #puts stdout "Next status pair is $a_pair"
  553.           set sfile [ lindex $a_pair 0 ] 
  554.           set ffile [ lindex $filelist $file_index ]
  555.           #puts stdout "status_pair for file \"$ffile\" is \"$sfile\""
  556.           if { [ isCmDirectory $ffile ] } {
  557.             #puts stdout "setup_dir: found CM directory."
  558.             set file_index [ expr $file_index + 1 ]
  559.           } else {
  560.             if { $ffile == $sfile } {
  561.               #puts stdout "matched! ffile: \"$ffile\"  sfile: \"$sfile\""
  562.               set end_index [ llength $a_pair ]
  563.               set status [ lrange $a_pair 1 $end_index ]
  564.               if { $status != "Up-to-date" } {
  565.                 .status_list insert end [ lrange $a_pair 1 $end_index ]
  566.               } else {
  567.                 .status_list insert end $up_to_date_with_repository
  568.               }
  569.               set pair_index [ expr $pair_index + 1 ]
  570.               set file_index [ expr $file_index + 1 ]
  571.             } elseif { $ffile < $sfile } {
  572.               #puts stdout "setup_dir: \"$ffile\" not in repository"
  573.               if [file isdirectory $ffile] {
  574.                 .status_list insert end $directory_label
  575.               } else {
  576.                 .status_list insert end $unknown_in_repository
  577.               }
  578.               set file_index [ expr $file_index + 1 ]
  579.             } else {
  580.               #puts stdout "setup_dir: \"$sfile\" in repository but not in local copy"
  581.               set pair_index [ expr $pair_index + 1 ]
  582.             }
  583.           }
  584.         }
  585.         # process any remaining local files which are not in the CVS repository 
  586.         #puts stdout "setup_dir: pi=$pair_index   plc=$pair_list_count fi=$file_index   flc=$file_list_count"
  587.         if { ( $pair_index == $pair_list_count ) && ( $file_index < $file_list_count ) } {
  588.           for { set i  $file_index } { $i < $file_list_count } { incr i +1} {
  589.             #puts stdout "pi=$pair_index   plc=$pair_list_count fi=$file_index   flc=$file_list_count"
  590.             set ffile [ lindex $filelist $i ]
  591.             if { ! [ isCmDirectory $ffile ] } {
  592.               if [file isdirectory $ffile] {
  593.                 #puts stdout "setup_dir: found directory."      
  594.                 .status_list insert end $directory_label
  595.               } else {
  596.                 #puts stdout "setup_dir: file \"$ffile\" is not in the repository."
  597.                 .status_list insert end $unknown_in_repository
  598.               }
  599.             }
  600.           }
  601.         } elseif { ( $pair_index == $pair_list_count ) && ( $file_index == $file_list_count ) } {
  602.           #puts stdout "setup_dir: pair_index == pair_list_count & file_index == file_list_count"
  603.           nop
  604.         } elseif { ( $pair_index < $pair_list_count ) && ( $file_index == $file_list_count ) } {
  605.           #puts stdout "setup_dir: file_index($file_index) == file_count($file_list_count)"
  606.           nop
  607.         } else {
  608.           # shouldn't ever get here
  609.           puts stderr "setup_dir: error in indicies in setup_dir"
  610.         }
  611.       }
  612.     }
  613.   }
  614.  
  615.   # resize scroll bar
  616.   # set scroll_data [.scroll get]
  617.   # set totalUnits [ lindex $scroll_data 0 ]
  618.   # set windowUnits [ lindex $scroll_data 1 ]
  619.   # set firstUnit [ lindex $scroll_data 2 ]
  620.   # set lastUnit [ lindex $scroll_data 3 ]
  621.   #puts stdout "before scroll: \"[.scroll get]\""
  622.   #puts stdout "before scroll data: $totalUnits $windowUnits $firstUnit $lastUnit"
  623.   #puts stdout "before listbox: \"[.file_list configure]\""
  624.  
  625.   # .scroll set $j $windowUnits 0 $windowUnits
  626.   # set scroll_data [.scroll get]
  627.   # set totalUnits [ lindex $scroll_data 0 ]
  628.   # set windowUnits [ lindex $scroll_data 1 ]
  629.   # set firstUnit [ lindex $scroll_data 2 ]
  630.   # set lastUnit [ lindex $scroll_data 3 ]
  631.   #puts stdout "after scroll: \"[.scroll get]\""
  632.   #puts stdout "after scroll data: $totalUnits $windowUnits $firstUnit $lastUnit"
  633.   #puts stdout "after listbox: \"[.file_list configure]\""
  634.  
  635.   #puts stdout "setup_dir: exiting procedure."
  636.  
  637. }
  638.  
  639.  
  640. proc cvs_file_status_pairs {} {
  641.   global incvs
  642.   global cvsver
  643.  
  644.   #puts stdout "cvs_file_status_pairs: entering function."
  645.   if {! $incvs} {
  646.     cvs_notincvs
  647.     return 1
  648.   }
  649.   # Note:  This needs changing to be backwards compatible with CVS 1.2.
  650.   # It may not be possible, because CVS 1.2 does not have a long format
  651.   # status listing.
  652.   set commandline "exec cvs -q status -l . | "
  653.   set commandline "$commandline awk {\$3 ~ /Status:/ "
  654.   set commandline "$commandline { printf(\"%s %s %s %s %s^\", \$2, \$4, \$5, \$6, \$7 );}}"
  655.   #puts stdout "cvs_file_status_pairs: commandline is \"$commandline\""
  656.   catch { eval $commandline } view_this
  657.   set list_length [ expr [ llength $view_this ] -1]
  658.   set i 0
  659.   set str $view_this
  660.   set rtn_list ""
  661.   while {$i < $list_length } {
  662.     set start_index $i 
  663.     set end_index   [expr [ lsearch -regexp $str {\^} ] - 1 ]
  664.     regsub {\^} $str { } str
  665.     set filename [ lindex $str $i ]
  666.     set status   [ lrange $str [ expr $i + 1 ] $end_index ]
  667.     if { ( $end_index < 0 ) } {
  668.       set i $list_length
  669.     } else {
  670.       set i [ expr $end_index  + 1 ]
  671.     }
  672.     lappend rtn_list [ list $filename $status ]
  673.   }
  674.   #puts stdout "cvs_file_status_pairs: exiting procedure."
  675.   #puts "Return list = $rtn_list"
  676.   return $rtn_list
  677. }
  678.  
  679. proc read_cvs_adm_dir {dirname} {
  680. #
  681. # Reads an old format CVS.adm directory
  682. #
  683.   global module_dir
  684.   global incvs
  685.  
  686.   if [file isdirectory $dirname] {
  687.     if [file isfile $dirname/Repository] {
  688.       set module_dir [exec cat $dirname/Repository]
  689.       set incvs 1
  690.     } else {
  691.       cvserror "Repository file not found in $dirname"
  692.     }
  693.   } else {
  694.     cvserror "$dirname is not a directory"
  695.   }
  696. }
  697.  
  698. proc read_cvs_dir {dirname} {
  699. #
  700. # Reads a new format CVS directory
  701. #
  702.   global module_dir
  703.   global incvs
  704.   global cvscfg
  705.  
  706.   if [file isdirectory $dirname] {
  707.     if [file isfile $dirname/Repository] {
  708.       set module_dir [exec cat $dirname/Repository]
  709.       if [file isfile $dirname/Root] {
  710.         set cvscfg(admin_dir) [exec cat $dirname/Root]
  711.         set cvscfg(cvsver) 1.4
  712.       }
  713.       set incvs 1
  714.     } else {
  715.       cvserror "Repository file not found in $dirname"
  716.     }
  717.   } else {
  718.     cvserror "$dirname is not a directory"
  719.   }
  720. }
  721.  
  722. proc workdir_scroll { args } {
  723.  
  724. # To support scrolling 3 listboxes simultaneously
  725.  
  726.   #puts "args = $args"
  727.   eval ".file_list     yview $args"
  728.   eval ".status_list   yview $args"
  729.  
  730.   # set scroll_data [.scroll get]
  731.   # set totalUnits [ lindex $scroll_data 0 ]
  732.   # set windowUnits [ lindex $scroll_data 1 ]
  733.   # set firstUnit [ lindex $scroll_data 2 ]
  734.   # set lastUnit [ lindex $scroll_data 3 ]
  735.  
  736.   #puts stdout "workdir scroll: scroll: \"[.scroll get]\""
  737.   #puts stdout "workdir scroll: listbox: \"[.file_list configure]\""
  738. }
  739.  
  740. proc workdir_cleanup {} {
  741.     global cvscfg
  742.  
  743.     set commandline "$cvscfg(rm_cmd) $cvscfg(clean_these)"
  744.     if { [ are_you_sure "You are about to execute this delete command:\n$commandline" {} ] == 1 } {
  745.         set list [ split $cvscfg(clean_these) " " ]
  746.         set results ""
  747.         foreach item $list {
  748.             if { $item != "" } {
  749.                 #puts stdout "cleaning up matches for patterh \"$item\""
  750.                 catch { eval exec $cvscfg(rm_cmd) $cvscfg(rm_flags) [ glob $item ] } view_this
  751.                 if { $view_this != "" } {
  752.                     set results "$results\n$view_this"
  753.                 }
  754.             } else {
  755.                 nop
  756.             }
  757.         }
  758.         view_output "Clean" $results
  759.         setup_dir
  760.     }
  761. }
  762.  
  763. proc workdir_delete_file args {
  764.   global cvscfg
  765.  
  766.   if {$args == "{}"} {
  767.     cvserror "Please select some files to delete first!"
  768.     return
  769.   }
  770.  
  771.   if { [ are_you_sure "This will delete these files:" $args ] == 1 } {
  772.     foreach file $args {
  773.       eval "exec $cvscfg(rm_cmd) $cvscfg(rm_flags) $file "
  774.     }
  775.     setup_dir
  776.   }
  777. }
  778.  
  779. proc are_you_sure {mess args} {
  780. #
  781. # General posting message
  782. #
  783.    global cvscfg
  784.  
  785.    
  786.    if { $cvscfg(confirm_prompt) != "false" } {
  787.        set mess "$mess\n"
  788.        set indent "      "
  789.        set list [ split [ lindex [ lindex $args 0 ] 0 ] " \t\n" ]
  790.        foreach item $list {
  791.            if { $item != {} } {
  792.                set mess "$mess $indent"
  793.                set val [ lindex $item 0 ]
  794.                set mess "$mess $val\n"
  795.            }
  796.        }
  797.        set mess "$mess\nAre you sure?"
  798.        set confirm [tk_dialog .message {Confirm!} $mess warning 1 OK Quit]
  799.        
  800.        if {$confirm != 0} {
  801.            set confirm [tk_dialog .message {Confirm!} "Aborted at user request." warning 0 OK]
  802.            return 0
  803.        }
  804.    }
  805.    return 1
  806. }
  807.  
  808.  
  809. # 
  810. # Sets all cursors to busy, executes command, and restores cursors.
  811. # 
  812. # I believe I got this from GIC. Only some of the functions use it;
  813. # was not immediately clear to me how to get all functions to use it, 
  814. # however.
  815. # -sj
  816. #
  817. proc busy {cmds} {
  818. #    global errorInfo
  819.  
  820.     set busy {.app}
  821.     set list [winfo children .]
  822.     while {$list != ""} {
  823.         set next {}
  824.         foreach w $list {
  825.             set cursor [lindex [$w config -cursor] 4]
  826.             if {[winfo toplevel $w] == $w || $cursor != ""} {
  827.                 lappend busy [list $w $cursor]
  828.             } else {
  829.                 lappend busy [list $w {}]
  830.             }
  831.             set next [concat $next [winfo children $w]]
  832.         }
  833.         set list $next
  834.     }
  835.  
  836.     foreach w $busy {
  837.         catch {[lindex $w 0] config -cursor watch}
  838.     }
  839.  
  840.     update idletasks
  841.  
  842.     set error [catch {uplevel eval $cmds} result]
  843. #    set ei $errorInfo
  844.  
  845.     foreach w $busy {
  846.         catch {[lindex $w 0] config -cursor [lindex $w 1]}
  847.     }
  848.  
  849.     if $error {
  850. #       error $result $ei
  851.     } else {
  852.         return $result
  853.     }
  854. }
  855.  
  856.  
  857. proc workdir_print_file args {
  858.   global cvscfg
  859.  
  860.   if {$args == "{}"} {
  861.     cvserror "Please select some files to print first!"
  862.     return
  863.   }
  864.  
  865.   set mess "This will print these files:\n\n"
  866.  
  867.   foreach file $args {
  868.     set mess "$mess   $file\n"
  869.   }
  870.  
  871.   set mess "$mess\nAre you sure?"
  872.   set confirm [tk_dialog .message {Confirm!} $mess warning 1 OK Quit]
  873.  
  874.   if {$confirm == 0} {
  875.     foreach file $args {
  876.       exec $cvscfg(print_cmd) $file
  877.     }
  878.   }
  879. }
  880.  
  881.  
  882. proc workdir_format_file args {
  883.   global cvscfg
  884.  
  885.   if {$args == "{}"} {
  886.     cvserror "Please select some files to print first!"
  887.     return
  888.   }
  889.  
  890.   if { [ are_you_sure "This will format these files:" $args ] == 1} {
  891.     foreach file $args {
  892.       exec $cvscfg(format_cmd) $file
  893.     }
  894.     setup_dir
  895.   }
  896. }
  897.  
  898.  
  899. proc cvsroot_check {} {
  900.   global cvscfg
  901.   global working_cvsroot
  902.   global incvs
  903.   global env
  904.  
  905.   if { $incvs } {
  906.     if [file isfile "./CVS/Root"] {
  907.       set f [ open "./CVS/Root" r ]
  908.       gets $f root
  909.       close $f
  910.       set env(CVSROOT) $root
  911.     }
  912.   }
  913.   set working_cvsroot $env(CVSROOT)
  914. }
  915.  
  916.  
  917. proc nop {} {}
  918.  
  919. proc disabled {} {
  920.     set confirm [tk_dialog .message {Confirm!} "Command disabled.." warning 0 OK]
  921. }
  922.  
  923. proc isCmDirectory { file } {
  924.     switch $file  {
  925.         "CVS"  - 
  926.         "CVS.adm"  - 
  927.         "RCS"  - 
  928.         "SCCS" { set value 1 } 
  929.         default { set value 0 } 
  930.     }
  931.     return $value
  932. }
  933.  
  934. # Get the files in the current working directory.  Use the file_filter
  935. # values Add hidden files if desired by the user.  Sort them to match
  936. # the ordering that will be returned by cvs commands (this matches the
  937. # default ls ordering.).
  938.  
  939. proc getFiles {} {
  940.     global cvscfg
  941.  
  942.     set filelist ""
  943.     
  944.     # make sure the file filter is at least set to "*".
  945.     if { $cvscfg(file_filter) == "" } {
  946.         set cvscfg(file_filter) "*"
  947.     }
  948.  
  949.     # get the initial file list, including hidden if requested
  950.     if {$cvscfg(allfiles)} {
  951.         # get hidden as well
  952.         foreach item $cvscfg(file_filter) {
  953.             catch { set filelist [ concat [ glob .$item $item ] $filelist ] }
  954.             }
  955.     } else {
  956.         foreach item $cvscfg(file_filter) {
  957.             catch { set filelist [ concat [ glob $item ] $filelist ] }
  958.         }
  959.     }
  960.  
  961.     # make sure "." is always in the list for 'cd' purposes
  962.     if { ( [ lsearch -exact $filelist "." ] == -1 ) } {
  963.         set filelist [ concat "." $filelist ]
  964.     }
  965.     
  966.     # make sure ".." is always in the list for 'cd' purposes
  967.     if { ( [ lsearch -exact $filelist ".." ] == -1 ) } {
  968.         set filelist [ concat ".." $filelist ]
  969.     }
  970.     
  971.     # sort it
  972.     set filelist [ lsort $filelist ]
  973.     
  974.     # if this directory is under CVS and CVS is not in the list, add it. Its
  975.     # presence is needed for later processing
  976.     if { ( [ file exists "CVS" ] ) && 
  977.          ( [ lsearch -exact $filelist "CVS" ] == -1 ) } {
  978.         #puts "********* added CVS"
  979.         catch { set filelist [ concat "CVS" $filelist ] }
  980.     }
  981.     #puts stdout "-------------\nfilelist=$filelist\n------------\n"
  982.     return $filelist
  983. }
  984.  
  985. proc feedback_cvs { message } {
  986.   #######################################################################    
  987.   # This code is adapted from the text "Practical Programming in
  988.   # Tcl and Tk", by Brent B. Welch (see page 209)
  989.   # An entry widget is used because it won't change size
  990.   # base on the message length, and it can be scrolled by
  991.   # dragging with button 2.
  992.   # Author: Eugene Lee, Aerospace Corporation, 9/6/95
  993.   #######################################################################    
  994.   global feedback
  995.   global cvscfg
  996.  
  997.   set e $feedback(cvs)
  998.   $e config -state normal
  999.   $e delete 0 end
  1000.   $e insert 0 $message
  1001.   # Leave the entry in a read-only state
  1002.   $e config -state disabled
  1003.  
  1004.   # Force a disable update
  1005.   update idletasks
  1006. }
  1007.